home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyLowLevel.p < prev    next >
Encoding:
Text File  |  1997-02-26  |  3.7 KB  |  181 lines  |  [TEXT/CWIE]
  1. unit MyLowLevel;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8. (* Global Bashing - Get constants from SysEqu.p *)
  9.  
  10. {$definec GetGlobalB(addr) Ptr(ad)^}
  11. {$definec SetGlobalB(addr, n) Ptr(ad)^ := n}
  12. {$definec GetGlobalW(ad) IntegerPtr(ad)^}
  13. {$definec SetGlobalW(ad, n) IntegerPtr(ad)^ := n}
  14. {$definec GetGlobalL(ad) LongIntPtr(ad)^}
  15. {$definec SetGlobalL(ad, n) LongIntPtr(ad)^ := n}
  16.  
  17.     function GetGlobalS (ad: univ longint): Str255;
  18.     procedure SetGlobalS (ad: univ longint; s: Str255);  { only bashes len+1 chars }
  19.  
  20. {$definec AddPtrLong( p, offset ) Ptr(ord4(p) + offset)}
  21. {$definec OffsetPtr( p, offset ) Ptr(p) := Ptr(ord4(p) + (offset))}
  22. {$definec SubPtrPtr( left, right ) (ord4(left) - ord4(right))}
  23. {$definec GetUnsignedByte( p, offset ) (AddPtrLong(p, offset)^ and $00FF)}
  24. {$definec SetUnsignedByte( p, offset, value ) (AddPtrLong(p, offset)^ := band(value, $00FF)}
  25. {$definec CompLS( a1, a2 ) (unsignedlong(a1) <= unsignedlong(a2))}
  26. {$definec CompLO( a1, a2 ) (unsignedlong(a1) < unsignedlong(a2))}
  27. {$definec CompHS( a1, a2 ) (unsignedlong(a1) >= unsignedlong(a2))}
  28. {$definec CompHI( a1, a2 ) (unsignedlong(a1) > unsignedlong(a2))}
  29.  
  30.     procedure BSETW (var l: integer; num: integer);
  31.     procedure BCLRW (var l: integer; num: integer);
  32.     
  33. (* Register Getting - Address *)
  34.  
  35. {$IFC not GENERATINGPOWERPC}
  36.     function GetRegA0: Ptr;
  37.     inline
  38.         $2E88; (* movea.l    a0,(sp)        ; fetch a0 into tos    *)
  39.     function GetRegA1: Ptr;
  40.     inline
  41.         $2E89;
  42.     function GetRegA2: Ptr;
  43.     inline
  44.         $2E8A;
  45.     function GetRegA3: Ptr;
  46.     inline
  47.         $2E8B;
  48.     function GetRegA4: Ptr;
  49.     inline
  50.         $2E8C;
  51.     function GetRegA5: Ptr;
  52.     inline
  53.         $2E8D;
  54.     function GetRegA6: Ptr;
  55.     inline
  56.         $2E8E;
  57.     function GetRegA7: Ptr;
  58.     inline
  59.         $2E8F;
  60.  
  61. (* Register Setting - Address *)
  62.  
  63.     procedure SetRegA0 (n: univ Ptr);
  64.     inline
  65.         $205F; (* movea.l    (sp)+,a0        ; pop n into a0    *)
  66.     procedure SetRegA1 (n: univ Ptr);
  67.     inline
  68.         $225F;
  69.     procedure SetRegA2 (n: univ Ptr);
  70.     inline
  71.         $245F;
  72.     procedure SetRegA3 (n: univ Ptr);
  73.     inline
  74.         $265F;
  75.     procedure SetRegA4 (n: univ Ptr);
  76.     inline
  77.         $285F;
  78.     procedure SetRegA5 (n: univ Ptr);
  79.     inline
  80.         $2A5F;
  81.     procedure SetRegA6 (n: univ Ptr);
  82.     inline
  83.         $2C5F;
  84.     procedure SetRegA7 (n: univ Ptr);
  85.     inline
  86.         $2E5F;
  87.  
  88. (* Register Getting - Data *)
  89.  
  90.     function GetRegD0: longint;
  91.     inline
  92.         $2E80; (* move.l    d0,(sp)        ; fetch d0 into tos    *)
  93.     function GetRegD1: longint;
  94.     inline
  95.         $2E81;
  96.     function GetRegD2: longint;
  97.     inline
  98.         $2E82;
  99.     function GetRegD3: longint;
  100.     inline
  101.         $2E83;
  102.     function GetRegD4: longint;
  103.     inline
  104.         $2E84;
  105.     function GetRegD5: longint;
  106.     inline
  107.         $2E85;
  108.     function GetRegD6: longint;
  109.     inline
  110.         $2E86;
  111.     function GetRegD7: longint;
  112.     inline
  113.         $2E87;
  114.  
  115. (* Register Setting - Data *)
  116.  
  117.     procedure SetRegD0 (n: univ longint);
  118.     inline
  119.         $201F; (* move.l    (sp)+,(d0)        ; pop n into d0    *)
  120.     procedure SetRegD1 (n: univ longint);
  121.     inline
  122.         $221F;
  123.     procedure SetRegD2 (n: univ longint);
  124.     inline
  125.         $241F;
  126.     procedure SetRegD3 (n: univ longint);
  127.     inline
  128.         $261F;
  129.     procedure SetRegD4 (n: univ longint);
  130.     inline
  131.         $281F;
  132.     procedure SetRegD5 (n: univ longint);
  133.     inline
  134.         $2A1F;
  135.     procedure SetRegD6 (n: univ longint);
  136.     inline
  137.         $2C1F;
  138.     procedure SetRegD7 (n: univ longint);
  139.     inline
  140.         $2E1F;
  141. {$ENDC}
  142.  
  143. implementation
  144.  
  145.     uses
  146.         Memory;
  147.         
  148.     function GetGlobalS (ad: univ longint): Str255;
  149.         var
  150.             tmp: Str255;
  151.     begin
  152.         BlockMoveData(pointer(ad), @tmp, sizeof(tmp));
  153.         GetGlobalS := tmp;
  154.     end; (* GetGlobalB *)
  155.  
  156.     procedure SetGlobalS (ad: univ longint; s: Str255); (* only bashes}
  157. {len+1 chars *)
  158.     begin
  159.         BlockMoveData(@s, pointer(ad), Length(s) + 1);
  160.     end; (* GetGlobalB *)
  161.  
  162.     procedure BSETW (var l: integer; num: integer);
  163.         var
  164.             ll: longint;
  165.     begin
  166.         ll := l;
  167.         BSET(ll, num);
  168.         l := ll;
  169.     end;
  170.  
  171.     procedure BCLRW (var l: integer; num: integer);
  172.         var
  173.             ll: longint;
  174.     begin
  175.         ll := l;
  176.         BCLR(ll, num);
  177.         l := ll;
  178.     end;
  179.  
  180. end. 
  181.